home *** CD-ROM | disk | FTP | other *** search
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- END
- Attribute VB_Name = "ObjBezier"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
-
- Private MaxU As Integer ' Dimensions of control grid.
- Private MaxV As Integer
- Private Points() As Point3D ' Control points.
-
- ' grid holds a refined grid to display the surface.
- Private grid As ObjPicture
-
- ' u and v increment parameters.
- Private GapU As Single
- Private GapV As Single
- Private Du As Single
- Private Dv As Single
-
- ' Display flags.
- Private ShowControls As Boolean ' Draw control points?
- Private ShowGrid As Boolean ' Draw control grid?
-
- Function Factorial(ByVal n As Single) As Single
- Dim i As Integer
- Dim tot As Single
-
- tot = 1
- For i = 2 To n
- tot = tot * i
- Next i
- Factorial = tot
- End Function
-
- ' ************************************************
- ' Create the refined grid to display the surface.
- ' ************************************************
- Public Sub InitializeGrid(gap_x As Single, gap_z As Single, d_x As Single, d_z As Single)
- Dim u As Single
- Dim v As Single
- Dim x As Single
- Dim y As Single
- Dim z As Single
- Dim x1 As Single
- Dim y1 As Single
- Dim z1 As Single
- Dim pline As ObjPolyline
-
- GapU = gap_x
- GapV = gap_z
- Du = d_x
- Dv = d_z
-
- Set grid = New ObjPicture
-
- ' Create curves with constant u.
- For u = 0 To 1 + GapU / 10 Step GapU
- Set pline = New ObjPolyline
- grid.objects.Add pline
-
- SurfaceValue u, 0, x1, y1, z1
-
- For v = Dv To 1 + Dv / 10 Step Dv
- SurfaceValue u, v, x, y, z
- pline.AddSegment x1, y1, z1, x, y, z
- x1 = x
- y1 = y
- z1 = z
- Next v
- Next u
-
- ' Create curves with constant v.
- For v = 0 To 1 + GapV / 10 Step GapV
- Set pline = New ObjPolyline
- grid.objects.Add pline
-
- SurfaceValue 0, v, x1, y1, z1
- For u = Du To 1 + Du / 10 Step Du
- SurfaceValue u, v, x, y, z
- pline.AddSegment x1, y1, z1, x, y, z
- x1 = x
- y1 = y
- z1 = z
- Next u
- Next v
- End Sub
- ' ************************************************
- ' Apply a transformation matrix which may not
- ' contain 0, 0, 0, 1 in the last column to the
- ' object.
- ' ************************************************
- Public Sub ApplyFull(M() As Single)
- Dim i As Integer
- Dim j As Integer
-
- ' Apply the matrix to the grid if it exists.
- If Not grid Is Nothing Then grid.ApplyFull M
-
- ' Apply the matrix to the control points.
- For i = 0 To MaxU
- For j = 0 To MaxV
- m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
- Next j
- Next i
- End Sub
- ' ************************************************
- ' Apply a nonlinear transformation.
- ' ************************************************
- Public Sub Distort(D As Object)
- Dim i As Integer
- Dim j As Integer
-
- ' Distort the grid if it exists.
- If Not grid Is Nothing Then grid.Distort D
-
- ' Distort the sparse data.
- For i = 0 To MaxU
- For j = 0 To MaxV
- D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
- Next j
- Next i
- End Sub
- ' ************************************************
- ' Draw the transformed object on a Form, Printer,
- ' or PictureBox.
- ' ************************************************
- Public Sub Draw(canvas As Object, Optional r As Variant)
- Dim i As Integer
- Dim j As Integer
-
- ' Draw the grid if it exists.
- If Not grid Is Nothing Then grid.Draw canvas, r
-
- ' Draw the control points if desired.
- If ShowControls Then
- On Error Resume Next
- For i = 0 To MaxU
- For j = 0 To MaxV
- canvas.Line (Points(i, j).trans(1) - 2, Points(i, j).trans(2) - 2)-Step(4, 4), , BF
- Next j
- Next i
- End If
-
- ' Draw the control grid if desired.
- If ShowGrid Then
- On Error Resume Next
- For i = 0 To MaxU
- canvas.CurrentX = Points(i, 0).trans(1)
- canvas.CurrentY = Points(i, 0).trans(2)
- For j = 1 To MaxV
- canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
- Next j
- Next i
- For j = 0 To MaxV
- canvas.CurrentX = Points(0, j).trans(1)
- canvas.CurrentY = Points(0, j).trans(2)
- For i = 1 To MaxU
- canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
- Next i
- Next j
- End If
- End Sub
-
- ' ************************************************
- ' Read a Bezier surface from a file using Input.
- ' Assume the "BEZIER" label has already been
- ' read.
- ' ************************************************
- Public Sub FileInput(filenum As Integer)
- Dim i As Integer
- Dim j As Integer
-
- ' Get the basic information.
- Input #filenum, MaxU, MaxV, GapU, GapV, Du, Dv
-
- ' Allocate the Data array.
- SetBounds MaxU + 1, MaxV + 1
-
- ' Read the control points.
- For i = 0 To MaxU
- For j = 0 To MaxV
- Input #filenum, _
- Points(i, j).coord(1), _
- Points(i, j).coord(2), _
- Points(i, j).coord(3)
- Points(i, j).coord(4) = 1
- Next j
- Next i
-
- ' Initialize the grid data.
- If Du = 0 Then
- Set grid = Nothing
- Else
- InitializeGrid GapU, GapV, Du, Dv
- End If
- End Sub
-
-
-
-
- ' ************************************************
- ' Write a Bezier surface to a file using Write.
- ' Begin with "BEZIER" to identify this object.
- ' ************************************************
- Public Sub FileWrite(filenum As Integer)
- Dim i As Integer
- Dim j As Integer
-
- ' Write basic information.
- Write #filenum, "BEZIER", _
- MaxU, MaxV, GapU, GapV, Du, Dv
-
- ' Write the data.
- For i = 0 To MaxU
- For j = 0 To MaxV
- Write #filenum, _
- Points(i, j).coord(1), _
- Points(i, j).coord(2), _
- Points(i, j).coord(3)
- Next j
- Next i
- End Sub
- ' ************************************************
- ' Write the Bezier curve's grid object to a file
- ' using Write. The data can later be loaded into
- ' an ObjPicture object but not an ObjBezier
- ' object.
- ' ************************************************
- Public Sub FileWriteGrid(filenum As Integer)
- If Not grid Is Nothing Then grid.FileWrite filenum
- End Sub
-
- ' ***********************************************
- ' Fix the data coordinates at their transformed
- ' values.
- ' ***********************************************
- Public Sub FixPoints()
- Dim i As Integer
- Dim j As Integer
- Dim k As Integer
-
- ' Fix the grid points if the grid exists.
- If Not grid Is Nothing Then grid.FixPoints
-
- ' Fix the controls points.
- For i = 0 To MaxU
- For j = 0 To MaxV
- For k = 1 To 3
- Points(i, j).coord(k) = _
- Points(i, j).trans(k)
- Next k
- Next j
- Next i
- End Sub
-
-
- ' ***********************************************
- ' Return a string indicating the object type.
- ' ***********************************************
- Property Get ObjectType() As String
- ObjectType = "BEZIER"
- End Property
- ' ************************************************
- ' Let the user know if we are drawing the control
- ' grid.
- ' ************************************************
- Property Get DrawGrid() As Boolean
- DrawGrid = ShowGrid
- End Property
-
- ' ************************************************
- ' Let the user know if we are drawing the control
- ' points.
- ' ************************************************
- Property Get DrawControls() As Boolean
- DrawControls = ShowControls
- End Property
-
-
- ' ************************************************
- ' Let the user decide whether we should draw the
- ' control grid.
- ' ************************************************
- Property Let DrawGrid(value As Boolean)
- ShowGrid = value
- End Property
- ' ************************************************
- ' Let the user decide whether we should draw the
- ' control points.
- ' ************************************************
- Property Let DrawControls(value As Boolean)
- ShowControls = value
- End Property
-
-
-
-
- ' ************************************************
- ' Apply a transformation matrix to the object.
- ' ************************************************
- Public Sub Apply(M() As Single)
- Dim i As Integer
- Dim j As Integer
-
- ' Apply the matrix to the grid if it exists.
- If Not grid Is Nothing Then grid.Apply M
-
- ' Apply the matrix to the control points.
- For i = 0 To MaxU
- For j = 0 To MaxV
- m3Apply Points(i, j).coord, M, Points(i, j).trans
- Next j
- Next i
- End Sub
-
-
-
-
-
- ' ************************************************
- ' Set MaxU and MaxV ans allocate room for the
- ' control points.
- ' ************************************************
- Public Sub SetBounds(NumX As Integer, NumZ As Integer)
- MaxU = NumX - 1
- MaxV = NumZ - 1
- ReDim Points(0 To NumX, 0 To NumZ)
- End Sub
-
- ' ************************************************
- ' Set the value for a control point.
- ' ************************************************
- Public Sub SetControlPoint(i As Integer, j As Integer, x As Single, y As Single, z As Single)
- Points(i - 1, j - 1).coord(1) = x
- Points(i - 1, j - 1).coord(2) = y
- Points(i - 1, j - 1).coord(3) = z
- Points(i - 1, j - 1).coord(4) = 1
- End Sub
- ' ************************************************
- ' Return the value of the Bezier surface at this
- ' position.
- ' ************************************************
- Private Sub SurfaceValue(u As Single, v As Single, x As Single, y As Single, z As Single)
- Dim p As Integer
- Dim i As Integer
- Dim j As Integer
- Dim pt As Point3D
- Dim Bix As Single
- Dim Bjz As Single
-
- For i = 0 To MaxU
- ' Compute Bix.
- Bix = Factorial(MaxU) / Factorial(i) / _
- Factorial(MaxU - i) * _
- u ^ i * (1 - u) ^ (MaxU - i)
-
- For j = 0 To MaxV
- ' Compute Bjz.
- Bjz = Factorial(MaxV) / Factorial(j) / _
- Factorial(MaxV - j) * _
- v ^ j * (1 - v) ^ (MaxV - j)
-
- ' Add to the coordinates.
- For p = 1 To 3
- pt.coord(p) = pt.coord(p) + _
- Points(i, j).coord(p) * _
- Bix * Bjz
- Next p
- Next j
- Next i
-
- ' Prepare the output.
- x = pt.coord(1)
- y = pt.coord(2)
- z = pt.coord(3)
- End Sub
-